home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Libraries / SAT 2.3a1 / Zkrolly ƒ / Zkrolly.p < prev    next >
Encoding:
Text File  |  1994-11-03  |  3.0 KB  |  107 lines  |  [TEXT/PJMM]
  1. program Zkrolly;
  2.     uses
  3. {$ifc UNDEFINED THINK_PASCAL}
  4.         Types, QuickDraw, Fonts, Windows, Dialogs, OSUtils, Memory, {}
  5. {$endc}
  6.         SAT, sXprite, sZprite;
  7.  
  8.     var
  9.         ignoresp, zp: SpritePtr;
  10.         zWind: WindowPtr;
  11.         r: Rect;
  12.  
  13.     const
  14.         scrollSizeH = 200;
  15.         scrollSizeV = 150;
  16.  
  17.     function IsOptionPressed: Boolean;
  18.         var
  19.             km: KeyMap;
  20.     begin
  21.         GetKeys(km);
  22.         IsOptionPressed := km[58];
  23.     end;
  24.  
  25.     function Zyncho: Boolean;
  26.         var
  27.             where, dest: Rect;
  28.     begin
  29.         where.topLeft := zp^.position;
  30.         where.left := where.left - scrollSizeH div 2;
  31.         where.top := where.top - scrollSizeV div 2;
  32.         if where.left < 0 then
  33.             where.left := 0;
  34.         if where.top < 0 then
  35.             where.top := 0;
  36.         if where.left + scrollSizeH > gSAT.offSizeH then
  37.             where.left := gSAT.offSizeH - scrollSizeH;
  38.         if where.top + scrollSizeV > gSAT.offSizeV then
  39.             where.top := gSAT.offSizeV - scrollSizeV;
  40.         where.bottom := where.top + scrollSizeV;
  41.         where.right := where.left + scrollSizeH;
  42.         SetRect(dest, 0, 0, scrollSizeH, scrollSizeV);
  43.  
  44.         CopyBits(gSAT.offScreen^.portBits, gSAT.wind^.portBits, where, dest, srcCopy, nil);
  45.  
  46. {SATCopyBitsToScreen is obsolete - CopyBits is at least as fast for large areas anyway.}
  47. {For scrolling games, we must use other methods for improving the frame rate, like interlacing.}
  48.  
  49. {SATCopyBitsToScreen(gSAT.offScreen, where, dest, IsOptionPressed);}
  50. {Note that there's hardly any speed difference between fast and safe mode when copying areas this big!}
  51.  
  52.         Zyncho := true; {Tell SAT not to draw on-screen: we do that ourselves!}
  53.     end;
  54.  
  55.     procedure SetupZwind;
  56.         var
  57.             zr: Rect;
  58.             wrld: SysEnvRec;
  59.     begin
  60. {Since SAT hasn't been initialized yet, we can't use gSAT.colorFlag but have to check environs ourselves.}
  61.         if noErr <> SysEnvirons(1, wrld) then
  62.             ; {ignore errors}
  63.         SetRect(zr, 20, 30, 20 + scrollSizeH, 30 + scrollSizeV);
  64.         if wrld.hasColorQD then
  65.             Zwind := NewCWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0)
  66.         else
  67.             Zwind := NewWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0);
  68.     end;
  69.  
  70. begin
  71. {In case this isn't Think Pascal we have to make the standard inits ourselves.}
  72. {$IFC UNDEFINED THINK_PASCAL}
  73.     InitGraf(@qd.thePort);
  74.     InitFonts;
  75.     InitWindows;
  76.         {InitMenus;}
  77.         {TEInit;}
  78.     InitDialogs(nil);
  79.     MaxApplZone;
  80. {$ENDC}
  81.  
  82.     SetupZwind;
  83.  
  84.     SetRect(r, 0, 0, 510, 340);
  85.     SATCustomInit(128, 129, r, zwind, nil, false, false, false, true, false);
  86.     InitXprite;
  87.     InitZprite;
  88.     ShowWindow(gSAT.wind);
  89.     SelectWindow(gSAT.wind);
  90.     SATInstallSynch(@Zyncho);
  91.     zp := SATNewSprite(0, 90, 70, @SetupZprite);
  92.     ignoresp := SATNewSprite(0, 120, 100, @SetupXprite);
  93.     ignoresp := SATNewSprite(0, 200, 160, @SetupXprite);
  94.     SATSetPortScreen;
  95.     repeat
  96.         SATRun(IsOptionPressed);
  97.     until Button;
  98.  
  99. {WARNING! It seems like we mess up the current device somewhere. Probably a bug in SAT}
  100. {(where the device setting isn't perfect yet). Let's set port and device to something nice}
  101. {and safe!}
  102.     SetPort(gSAT.wind);
  103.     if gSAT.colorFlag then
  104.         SetGDevice(GetMainDevice);
  105. { Finally, make sure we dispose of the sound channel. }
  106.     SATSoundShutup;
  107. end.